package gri2_rsatcp;

# vim: ts=4:sw=4:et:syntax=perl

#
# This module makes use of RSA and twofish encryption to provide a basic non-deterministic asymmetric 
# encryption function. For RSA functionality has been designed to work with either of the following 
# two Perl implementations:
#
# OpenSSL::Crypt::RSA
# Crypt::RSA
#
# Obviously these only encode small blobs of data and
# so we need to make use of the Crypt::CBC module to handle
# meaningful lengths of data after then initial random
# key exchange.
#
# Notice this is TWO-WAY RSA authentication - the server needs
# to have public keys of all clients, since it will send over the
# onetime key encrpyted using it
#
# client: INInnn<my ident nnn bytes b64 clear text>\n
#         Ident used by server to encrypt session key for client
#
# server: RSAnnnnnnnnn<nnn b64 128bit session key>\n
#
#         By using RSA above we ensure the session key can only be decoded by
#         the valid client - which is then necessary for actual transfer of
#         any data...
#
# client: QQQnnnnnnnnn<b64 nnnn bytes of request using twofish/session-key>\n
#
# server: RRRnnnnnnnnn<b64 nnnn bytes of response using twofish/session-key>\n
# 
#
# The QQQ handler might spceified a maximum packet size expected to
# avoid a malicious client sending it too much data, though that would be
# optional.
#
# The actual higher level procotol would be responsible for the actual validation#
# of the format of the b64 data ... but the following is recommended:
# JSON<actual json>
# So if first 4 bytes are not JSON the packet is not valid...

# Routines this module needs to provide:
# =====================================
# [1] gen_rsa_key_pair(bits,email,username/host,comment) - -> (0,[errs]) or (1,$rsa) - generate and return new public/private keys
#
# [2] write_public_key(rsa,email,username/host,comment,file) - generate public key file with comment info
#       -> (0,[errs]) or (1,undef)
#
# [3] write_private_key(rsa,email,username/host,comment,file) - write out private key with comment info
#       -> (0,[errs]) or (1,undef)
#
# [4] load_public_key(file) - read public key file
#       -> (1,{rsa_public_key,username/host,email,comment})
#          (0,[errs])
#
# [5] load_private_key(file) - read private key file
#       -> (1,{rsa_private_key,username/host,email,comment})
#          (0,[errs])
#
# [6] load_all_private_keys(dir) - read all .private keys in dir
#       -> (1,{username/host} ->{rsa_private_key,username/host,email,comment},[warns]);
#          (0,[errs],[warns])
#
# [7] load_all_public_keys(dir) - read all .public keys in dir
#       -> (1,{username/host} ->{rsa_public_key,username/host,email,comment},[warns]);
#          (0,[errs],[warns])
#
# [8] client_send_data(fd,private,username/host,message) - generate ident and message to send
#           Send over a request in clear and accept and decode the session key from
#           the server using our private key.
#           Then send the actual message using the session key and return the session key
#           for later reading of the response from the server.
#           returns(0,[errs]) or (1,session_key)
#
# [9] client_recv_data(fd,session_key) - get and decode server responses message using sockets 
#          and session_key (twofish)
#       -> (0,[errs]) - errors have occured
#          (1,ident,$msg) - ident and message
#           This is quite straightforward of the decode of the message:
#           RRRnnnnnnnnn<b64 nnnn bytes b64 enc two-fish enc>\n

#
# [10] server_recv_data(fd,pub_keys) >(1,session_key,request) or (0,[errors])
#           When a client has made a connection this is called with
#           our public keys to check if ident if known. If so we 
#           encode a 16digit session key and push response to client
#           encrypted using there public key so. Then await the request and
#           return it.
# 
# [11] server_send_data(fd,session_key,message)
#           Once the server has sent back a session key and recieved
#           the actual request to perform the end results are sent
#           back using this routine.
#           RRRnnnnnnnnn<b64 nnnn bytes enc two-fish string>\n
#           (0,[errors]) or (1,session_key)
#
use warnings;
use strict;
use File::Spec;
use MIME::Base64;
use Data::Dumper;
use Crypt::CBC;
use Crypt::Twofish;
use Config;

my $has_crypt_rsa;
my $has_crypt_random;
my $has_crypt_openssl_rsa;
my $has_crypt_openssl_random;

BEGIN {
	eval "use Crypt::OpenSSL::RSA;";
	if($@) {
		$has_crypt_openssl_rsa=0;
	} else {
		$has_crypt_openssl_rsa=1;
	}
	eval "use Crypt::RSA;";
	if($@) {
		$has_crypt_rsa=0;
	} else {
		$has_crypt_rsa=1;
	}
	eval "use Crypt::OpenSSL::Random;";
	if($@) {
		$has_crypt_openssl_random=0;
	} else {
		$has_crypt_openssl_random=1;
	}
	eval "use Crypt::Random;";
	if($@) {
		$has_crypt_random=0;
	} else {
		$has_crypt_random=1;
	}
    if(! $has_crypt_openssl_rsa && ! $has_crypt_rsa) {
        die "No RSA functionality present";
    }
}

use Exporter;
$::VERSION = 1.00;
@::ISA = qw(Exporter);

@::EXPORT_OK = qw(
    gen_rsa_key_pair
    write_public_key
    write_private_key
    load_public_key
    load_private_key
    find_pub_key
    load_all_private_keys
    load_all_public_keys
    client_send_data
);
# Communication Format:
# ====================
# The below packet format is variable length, but the xxx and yyyyyyyyy determine exactly
# how much data needs to be read. All data is b64 encoded whilst xxx and yyyyyyyyy are set
# width with leading zeros if necessary.
#
# RSAxxx<b64 ident xxx bytes long>yyyyyyyyy<b64 enc message yyyyyyyyy bytes long>\n
#
# An alternative - clear text format will be supported too...
#
# TXTxxx<b64 ident xxx bytes long>yyyyyyyyy<b64 txt message yyyyyyyyy bytes long>\n
#
# To send or recieve in clear txt simple pass in private or {pubkeys} as 'undef'.
#

sub _mk_ident($) {
my $r=shift;

    my $email=$r->{email};
    my $username_host=$r->{"username/host"};
    my $comment=$r->{comment};

    my $ident=encode_base64($email,'') . '|' . encode_base64($username_host,'') . '|' . encode_base64($comment,'');
    return $ident;
}

sub _get_ident($) {
my $id=shift;

    my @P=split(/\|/,$id);
    return {
        email           => decode_base64($P[0]),
        "username/host" => decode_base64($P[1]),
        comment         => decode_base64($P[2]),
    };
}

sub gen_rsa_key_pair($) {
my $r=shift;
my @R=qw(bits email username/host comment);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)]);
    }
    my $bits=$r->{bits};
    my $email=$r->{email};
    my $username_host=$r->{"username/host"};
    my $comment=$r->{comment};
    my $ident=_mk_ident($r);

    if($Config{osname} !~ /mswin/i && ! -e '/dev/random') {
        my @PATH = File::Spec->path();
        my $ps=undef;
        my $sha1sum=undef;
        for my $cp (@PATH) {
            my $s1=File::Spec->catfile($cp,'sha1sum');
            my $s2=File::Spec->catfile($cp,'ps');
            if(!defined($sha1sum) && -x $s1) {
                $sha1sum=$s1;
            }
            if(!defined($ps) && -x $s2) {
                $ps=$s2;
            }
            last if (defined($ps) && defined($sha1sum));
        }
        my @e=();
        if(!defined($ps)) {
            push @e,"Failed to find 'ps' command.";
        }
        if(!defined($sha1sum)) {
            push @e,"Failed to find 'sha1sum' command.";
        }
        if(@e) {
            return(0,[@e],undef);
        }
        my $s=0;
        if($has_crypt_rsa && $has_crypt_random) {
            $s=1;
        }
        if($has_crypt_openssl_random && $has_crypt_openssl_rsa) {
            $s=1;
            Crypt::OpenSSL::Random::random_seed(`$ps -ef| $sha1sum -`);
            Crypt::OpenSSL::RSA->import_random_seed();
        }
        if(!$s) {
            return(0,["Missing required Crypt modules (see documentation)."]);
        }
    }
    # Now actually attempt to generate the key pair...
    my $rsa;
    if($has_crypt_rsa && $has_crypt_random) {
        my $rsa2=new Crypt::RSA;
        my ($pub,$priv)=$rsa2->keygen(
            Identify    => $ident,
            Size        => $bits,
            Verbosity   => 1,
        ) or return(0,["Failed to generate key-pair.",$rsa2->errstr()]);
        $rsa={type=>"crypt::rsa",ident=>$ident,rsa=>$rsa2,public=>$pub,private=>$priv};
        return(1,$rsa)
    } else {
        eval {$rsa=Crypt::OpenSSL::RSA->generate_key($bits); };
    }
    if(!$rsa) {
        return(0,["Call to Crypt::OpenSSL::RSA->generate_key failed.",$@],undef);
    }
    return(1,{ident=>$ident,type=>"crypt::openssl::rsa",rsa=>$rsa});
}

sub _cleanup($$$) {
my $fd=shift;
my $f=shift;
my $err=shift;

    close($fd);
    unlink($f);
    return(0,["Failed when writing to file '$f'.",$err]);
}

sub write_public_key($) {
my $r=shift;
my @R=qw(rsa file);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)]);
    }
    my $rsa2=$r->{rsa};
    my $rsa=$rsa2->{rsa};
    my $ident=$rsa2->{ident};
    my $file=$r->{file};

    if($rsa2->{type} eq "crypt::rsa") {
        $rsa2->{public}->write(Filename => $file);
        # my $public=$rsa2->{public}->serialize();
        # my $enc=encode_base64($public); chomp $enc;
        my $fd;
        open($fd,">>$file") or return(0,["Failed to open file '$file' for writing:",$!]);
        my $enc="#-----BEGIN RSA-CRYPT PUBLIC KEY-----\n#Ident: $ident\n";
        if(!print $fd $enc) {
            return _cleanup($fd,$file,$!);
        }
        close($fd);
        return(1,undef);
    }

    my $fd;
    open($fd,">$file") or return(0,["Failed to open file '$file' for writing:",$!]);
    if(! print $fd $rsa->get_public_key_string() ) {
        return _cleanup($fd,$file,$!);
    }
    if(! print $fd "Ident: $ident\n" ) {
        return _cleanup($fd,$file,$!);
    }
    close($fd);
    return(1,undef);
}

sub write_private_key($) {
my $r=shift;
my @R=qw(rsa file);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)]);
    }
    my $rsa2=$r->{rsa};
    my $rsa=$rsa2->{rsa};
    my $ident=$rsa2->{ident};
    my $file=$r->{file};

    if($rsa2->{type} eq "crypt::rsa") {
        $rsa2->{private}->write(Filename => $file);
        my $enc="#-----BEGIN RSA-CRYPT PRIVATE KEY-----\n#Ident: $ident\n";
        my $fd;
        open($fd,">>$file") or return(0,["Failed to open file '$file' for writing:",$!]);
        if(! print $fd $enc) {
            return _cleanup($fd,$file,$!);
        }
        close($fd);
        return(1,undef);
    }

    my $fd;
    open($fd,">$file") or return(0,["Failed to open file '$file' for writing:",$!]);
    if(! print $fd $rsa->get_private_key_string() ) {
        return _cleanup($fd,$file,$!);
    }
    if(! print $fd "Ident: $ident\n" ) {
        return _cleanup($fd,$file,$!);
    }
    close($fd);
    return(1,undef);
}

sub load_public_key($) {
my $r=shift;
my @R=qw(file);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)]);
    }
    my $file=$r->{file};
    my $fd;
    my @D=();
    open($fd,$file) or return(0,["Failed to read file '$file':",$!]);
    @D=<$fd>; close($fd);
    my $type=0; # 1=crypt::openssl::rsa, 2=crypt::rsa
    # Check this is a public key...
    if(grep {/^-----BEGIN RSA PUBLIC KEY-----/} @D) {
        $type=1;
    }
    if(grep {/^#-----BEGIN RSA-CRYPT PUBLIC KEY-----/} @D) {
        $type=2;
    }
    if(!$type) {
        return(0,["File '$file' does not appear to contain a public key."]);
    }
    # Grab out the other details too...
    my %info=();
    my $ident='';
    my @l=grep {/^[#]{0,1}Ident:\s+/} @D;
    if(@l) {
            $l[0] =~ /^[#]{0,1}Ident:\s+(.*)/;
            my $x=$1; chomp $x;
            $ident=_get_ident($x);
    }
    if($type==1) {
        if(! $has_crypt_openssl_rsa) {
            return(0,["Crypt::OpenSSL::RSA support not available."]);
        }
        my $xx=join('',@D);
        my $pub;
        eval {$pub=Crypt::OpenSSL::RSA->new_public_key($xx); };
        if(! $pub) {
            return(0,["Failed to read RSA public key from file '$file'.",$@]);
        }
        return(1,{
            "type"              => "crypt::openssl::rsa",
            "rsa_public_key"    => $pub,
            "ident"             => $ident,
        });
    }
    if(! $has_crypt_rsa) {
        return(0,["Crypt::RSA support not available."]);
    }
    my $pub=new Crypt::RSA::Key::Public(Filename => $file);
    if(! $pub) {
        return(0,["Failed to extract RSA Public key from '$file'."]);
    }
    return(1,{
        "type"              => "crypt::rsa",
        "rsa_public_key"    => $pub,
        "ident"             => $ident,
    });
}

sub load_private_key($) {
my $r=shift;
my @R=qw(file);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)]);
    }
    my $file=$r->{file};
    my $fd;
    my @D=();
    open($fd,$file) or return(0,["Failed to read file '$file':",$!]);
    @D=<$fd>; close($fd);
    my $type=0; # 1=crypt::openssl::rsa, 2=crypt::rsa
    # Check this is a public key...
    if(grep {/^-----BEGIN RSA PRIVATE KEY-----/} @D) {
        $type=1;
    }
    if(grep {/^#-----BEGIN RSA-CRYPT PRIVATE KEY-----/} @D) {
        $type=2;
    }
    if(!$type) {
        return(0,["File '$file' does not appear to contain a public key."]);
    }
    # Grab out the other details too...
    my %info=();
    my $ident='';
    my @l=grep {/^[#]{0,1}Ident:\s+/} @D;
    if(@l) {
            $l[0] =~ /^[#]{0,1}Ident:\s+(.*)/;
            my $x=$1; chomp $x;
            $ident=_get_ident($x);
    }
    if($type==1) {
        if(! $has_crypt_openssl_rsa) {
            return(0,["Crypt::OpenSSL::RSA support not available."]);
        }
        my $xx=join('',@D);
        my $pub;
        eval {$pub=Crypt::OpenSSL::RSA->new_private_key($xx); };
        if(! $pub) {
            return(0,["Failed to read RSA private key from file '$file'.",$@]);
        }
        return(1,{
            "type"              => "crypt::openssl::rsa",
            "rsa_private_key"   => $pub,
            "ident"             => $ident,
        });
    }
    if(! $has_crypt_rsa) {
        return(0,["Crypt::RSA support not available."]);
    }
    my $priv=new Crypt::RSA::Key::Private(Filename => $file);
    if(! $priv) {
        return(0,["Failed to extract RSA Private key from '$file'."]);
    }
    return(1,{
        "type"              => "crypt::rsa",
        "rsa_private_key"   => $priv,
        "ident"             => $ident,
    });
}

sub load_all_private_keys($) {
my $r=shift;
my @R=qw(dir);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)],[]);
    }
    my $dir=$r->{dir}; my $dfd;
    opendir($dfd,$dir) or return(0,["Failed to read from directory '$dir'.",$!],[]);
    my @w=(); my %I=();
    while(my $cf=readdir($dfd)) {
        my $cp=File::Spec->catfile($dir,$cf);
        next if(! -f $cp);
        next if $cf !~ /\.private$/;

        my ($a,$b)=load_private_key({file=>$cp});
        if($a==0) {
            push @w,@$b;
            next;
        }
        $I{$b->{ident}->{"username/host"}}={%$b};
    }
    close($dfd);
    return(1,{%I},[@w]);
}

sub load_all_public_keys($) {
my $r=shift;
my @R=qw(dir);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)],[]);
    }
    my $dir=$r->{dir}; my $dfd;
    opendir($dfd,$dir) or return(0,["Failed to read from directory '$dir'.",$!],[]);
    my @w=(); my %I=();
    while(my $cf=readdir($dfd)) {
        my $cp=File::Spec->catfile($dir,$cf);
        next if(! -f $cp);
        next if $cf !~ /\.public$/;

        my ($a,$b)=load_public_key({file=>$cp});
        if($a==0) {
            push @w,@$b;
            next;
        }
        $I{$b->{ident}->{"username/host"}}={%$b};
    }
    close($dfd);
    return(1,{%I},[@w]);
}

sub find_priv_key($) {
my $r=shift;
my @R=qw(keys username/host);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)],[]);
    }
    my $keys=$r->{keys};
    my $username_host=$r->{'username/host'};
    if(!exists($keys->{$username_host})) {
        return(0,["Unable to find ident of '$username_host'."]);
    }
    return(1,$keys->{$username_host});
}

sub find_pub_key($) {
my $r=shift;
my @R=qw(keys username/host);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)],[]);
    }
    my $keys=$r->{keys};
    my $username_host=$r->{'username/host'};
    if(!exists($keys->{$username_host})) {
        return(0,["Unable to find ident of '$username_host'."]);
    }
    return(1,$keys->{$username_host});
}
sub _recv($$) {
my $fd=shift;
my $wanted=shift;
my $w2=$wanted;

    my $buf='';
    while ($wanted) {
        my $bb='';
        if($wanted<=10240) {
            recv($fd,$bb,$wanted,0);
        } else {
            recv($fd,$bb,10240,0);
        }
        if($bb) {
            $buf.=$bb;
            $wanted-=length($bb);
        } else {
            return(0,[$w2,$w2-$wanted]);
        }
    }
    return (1,$buf);
}

sub _send($$) {
my $fd=shift;
my $msg=shift;

    $msg=$$msg if(ref($msg));
    my $ln=length($msg);
    # Now actually send the data - 1kb at a time...
    my $off=0;
    my $togo=$ln;
    while($off<$ln) {
        my $mm;
        if($togo<=10240) {
            $mm=substr($msg,$off);
        } else {
            $mm=substr($msg,$off,10240);
        }
        my $p=send($fd,$mm,0);
        if(! $p) {
            return(0,[$ln,$off]);
        }
        $off+=$p;
        $togo-=$p;
    }
    return(1,undef);
}

sub client_recv_data($) {
my $r=shift;
my @R=qw(fd session_key);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)],[]);
    }
    my $fd=$r->{fd};
    my $session_key=$r->{session_key};
    # Get 1st 12 bytes of data to get is RRRnnnnnnnnn

    my ($rc,$i)=_recv($fd,12);
    if(! $rc) {
        return(0,["Only got $i->[1] bytes of server response header ($i->[0] bytes)."]);
    }
    if(substr($i,0,3) ne 'RRR') {
        return(0,["Expected response header RRR string in request header."]);
    }
    my $l=substr($i,3);
    if($l !~ /^\d+$/) {
        return(0,["Invalid response length for server response."]);
    }
    $l=int($l);
    ($rc,$i)=_recv($fd,$l+1); # b64 encoded twofish data
    if(! $rc) {
        return(0,["Only got $i->[1] bytes of server response ($i->[0] bytes)."]);
    }
    my $encrypted=decode_base64($i);
    my $cipher=Crypt::CBC->new( -key    => $session_key,
                                -cipher => 'Twofish'
                            );
    my $message=$cipher->decrypt($encrypted);
    return(1,$message);
}

sub server_recv_data($) {
my $r=shift;
my @R=qw(fd pub_keys);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)],[]);
    }
    my $fd=$r->{fd};
    my $pub_keys=$r->{pub_keys};
    # Get 1st 6 bytes of data to get length of b64 ident passwd

    my ($rc,$i)=_recv($fd,6); # 3 byte header, 3 byte length
    if(! $rc) {
        return(0,["Only got $i->[1] bytes of client key request/1 ($i->[0] bytes)."]);
    }
    if(substr($i,0,3) ne 'INI') {
        return(0,["Expected init string in request header."]);
    }
    my $l=substr($i,3);
    if($l !~ /^\d+$/) {
        return(0,["Invalid response length for ident length indicator from client."]);
    }
    $l=int($l);
    ($rc,$i)=_recv($fd,$l+1); # b64 encoded claer ident + \n
    if(! $rc) {
        return(0,["Only got $i->[1] bytes of client key request/2 ($i->[0] bytes)."]);
    }
    my $ident=decode_base64($i);
    # Check this is a known identity so we can use a public key to send it 
    # some stuff.
    if(!exists($pub_keys->{$ident})) {
        return(0,["Ignoring request from '$ident' - unknown identity."]);
    }
    my $public=$pub_keys->{$ident}->{rsa_public_key};
    my $type=$pub_keys->{$ident}->{type};

    my $str='';
    while(length($str)<16) {
        $str.=substr(sprintf('%.4f',rand()),2,4);
    }
    $str=substr($str,0,16);

    # Now we have a 16byte key to use send it back using the public 
    # encryption of the server in question...

    my $message;
    if($type eq 'crypt::rsa') {
        my $rsa = new Crypt::RSA;
        $message=$rsa->encrypt(
            Message => $str,
            Key     => $public,
            Armour  => 1
        ) || return(0,[$rsa->errstr()]);
    } else {
        $message=$public->encrypt($str);
    }
    $message=encode_base64($message,'');
    $l=length($message);
    $message=sprintf("RSA%09s%s\n",length($message),$message);

    ($rc,$i)=_send($fd,$message);
    if(! $rc) {
        return(0,["Only sent $i->[1] bytes of header/1 ($i->[0] bytes)."]);
    }
    my $session_key=$str;

    # Now the session has been sent we await the actual request in the 
    # format:
    # QQQnnnnnnnnn<b64 nnnn bytes of request using twofish/session-key>\n
    ($rc,$i)=_recv($fd,12); # 3 byte header, 9 byte length
    if(! $rc) {
        if($i>[1]==0) {
            return(0,["Got 0 bytes from client - invalid client or public/private key mismatch."]);
        }
        return(0,["Only got $i->[1] bytes of client request ($i->[0] bytes)."]);
    }
    if(substr($i,0,3) ne 'QQQ') {
        return(0,["Invalid request header from client."]);
    }
    $l=substr($i,3);
    if($l !~ /^\d+$/) {
        return(0,["Invalid request length from client."]);
    }
    $l=int($l);
    ($rc,$i)=_recv($fd,$l+1);
    if(! $rc) {
        if($i>[1]==0) {
            return(0,["Got 0 bytes from client - invalid client or public/private key mismatch."]);
        }
        return(0,["Only got $i->[1] bytes of client request ($i->[0] bytes)."]);
    }
    my $enc_request=decode_base64($i);
    my $cipher=Crypt::CBC->new( -key    => $session_key,
                                -cipher => 'Twofish'
                            );
    my $request=$cipher->decrypt($enc_request);
    return(1,$session_key,$request);
}
    
sub server_send_data($) {
my $r=shift;
my @R=qw(fd session_key message);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)],[]);
    }
    my $fd=$r->{fd};
    my $session_key=$r->{session_key};
    my $message=$r->{message};

    my $cipher=Crypt::CBC->new( -key    => $session_key,
                                -cipher => 'Twofish'
                            );
    $message=$cipher->encrypt($message);
    $message=encode_base64($message,'');
    my $ln=length($message);
    my $msg=sprintf("RRR%09d$message\n",$ln);
    my ($rc,$i)=_send($fd,$msg);
    if(! $rc) {
        return(0,["Only sent $i->[1] bytes of response ($i->[0] bytes)."]);
    }
    return(1,$session_key);   
}

sub client_send_data($) {
my $r=shift;
my @R=qw(fd username/host private message);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)],[]);
    }
    my $fd=$r->{fd};
    my $private=$r->{private};
    my $username_host=$r->{"username/host"};
    my $message=$r->{message};

    my $msg;
    if(!defined($private)) {
        die "Symmetric encryption not implemented yet.";
        $msg='ENC';
    } else {
        $msg='INI';
    }
    my $ident=encode_base64($username_host,'');
    my $xx=sprintf('%03d',length($ident));
    my $pfd=select($fd);
    $|=1;
    select($pfd);
    $msg.="$xx$ident\n";
    my ($rc,$i)=_send($fd,$msg);
    if(! $rc) {
        return(0,["Only sent $i->[1] bytes of header/1 ($i->[0] bytes)."]);
    }
    # At this point the server process should sent back a RSA
    # message encrypted so only we can decrypt in the format:
    # RSAnnnnnnnnn<nnn b64 128bit session key>\n
    ($rc,$i)=_recv($fd,12); # 3 byte header, 9 byte length
    if(! $rc) {
        return(0,["Only got $i->[1] bytes of server key response/1 ($i->[0] bytes)."]);
    }
    if(substr($i,0,3) ne 'RSA') {
        return(0,["Invalid response for key response from server."]);
    }
    my $l=substr($i,3);
    if($l !~ /^\d+$/) {
        return(0,["Invalid response for key response from server."]);
    }
    $l=int($l);
    ($rc,$i)=_recv($fd,$l+1);
    if(! $rc) {
        return(0,["Only got $i->[1] bytes of server key response/2 ($i->[0] bytes)."]);
    }
    my $session_key=decode_base64($i);
    {
        if($private->{type} eq 'crypt::rsa') {
            my $rsa = new Crypt::RSA;
                # Key     => $private->{rsa_private_key},
            $session_key=$rsa->decrypt(
                Cyphertext => $session_key,
                Key     => $private->{rsa_private_key},
                Armour  => 1
            ) || return(0,[$rsa->errstr()]);
        } else {
            $session_key=$private->{rsa_private_key}->decrypt($session_key);
        }
    }
    my $cipher=Crypt::CBC->new( -key    => $session_key,
                                -cipher => 'Twofish'
                            );
    $message=$cipher->encrypt($message);
    $message=encode_base64($message,'');
    my $ln=length($message);
    $msg=sprintf("QQQ%09d$message\n",$ln);
    ($rc,$i)=_send($fd,$msg);
    if(! $rc) {
        return(0,["Only sent $i->[1] bytes of request ($i->[0] bytes)."]);
    }
    return(1,$session_key);   
}

__DATA__

# When we send data we are given the public key of the
# recipient to encrpyt the data.. username/host is local id
sub send_data($) {
my $r=shift;
my @R=qw(fd username/host public message);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)],[]);
    }
    my $fd=$r->{fd};
    my $public=$r->{public};
    my $username_host=$r->{"username/host"};
    my $message=$r->{message};

    my $msg;
    if(!defined($public)) {
        $msg='TXT';
    } else {
        $msg='RSA';
    }
    my $ident=encode_base64($username_host,'');
    my $xx=sprintf('%03d',length($ident));
    my $pfd=select($fd);
    $|=1;
    select($pfd);
    $msg.="$xx$ident";
    my $p=send($fd,$msg,0);
    if($p != length($msg)) {
        return(0,["Only sent $p bytes of header/1 (" . length($msg) . " bytes)."]);
    }
    # Now actually send length
    if(!defined($public)) {
        $message=encode_base64($message,'');
    } else {
        if($public->{type} eq 'crypt::rsa') {
            my $rsa = new Crypt::RSA;
            $message=$rsa->encrypt(
                Message => $message,
                Key     => $public->{rsa_public_key},
                Armour  => 1
            );
        } else {
            $message=$public->{rsa_public_key}->encrypt($message);
        }
        $message=encode_base64($message,'');
    }
    my $ln=length($message);
    $msg=sprintf("%09d",$ln);
    $p=send($fd,$msg,0);
    if($p != length($msg)) {
        return(0,["Only sent $p bytes of header/2 (" . length($msg) . " bytes)."]);
    }
    # Now actually send the data - 1kb at a time...
    my $off=0;
    while($off<$ln) {
        my $mm;
        if($off<1024) {
            $mm=substr($msg,$off);
        } else {
            $mm=substr($msg,$off,1024);
        }
        $p=send($fd,$mm,0);
        if($p != length($mm)) {
            return(0,["Only sent $p bytes of data block (" . length($mm) . " bytes)."]);
        }
        $off+=1024;
    }
    $msg="\n";
    $p=send($fd,$msg,0);
    if($p != length($msg)) {
        return(0,["Only sent $p bytes of trailer (" . length($msg) . " bytes)."]);
    }
    return(1,undef);   
}

# We get a package and decode it using our private key...

sub recv_data($) {
my $r=shift;
my @R=qw(fd private);

    my @m=();
    for my $cr (@R) {
        if(!exists($r->{$cr}) || !defined($r->{$cr})) {
            push @m,$cr;
        }
    }
    if(@m) {
        return(0,["Missing mandatory parameters: " . join(',',@m)],[]);
    }
    my $fd=$r->{fd};
    my $private=$r->{private};

    # Read the type of record bytes first...
    my $buf='';
    my $wanted=6;
    while ($wanted) {
        my $bb='';
        recv($fd,$bb,$wanted,0);
        if($bb) {
            $buf.=$bb;
            $wanted-=length($bb);
        } else {
            return(0,["Failed to read first header/1 block."]);
        }
    }
    my $bbb=substr($buf,3);
    if($bbb !~ /^\d+$/) {
        return(0,["Header block length not specified as number."]);
    }
    my $next=int($bbb);
    my $type=substr($buf,0,3);
    # Now we read/decoe the username/host string +9 bytes (for message size part)

    $wanted=$next+9;
    $buf='';
    while ($wanted) {
        my $bb='';
        recv($fd,$bb,$wanted,0);
        if($bb) {
            $buf.=$bb;
            $wanted-=length($bb);
        } else {
            return(0,["Failed to read header/2 block."]);
        }
    }
    $bbb=substr($buf,$next);
    if($bbb !~ /^\d+$/) {
        return(0,["Data block length not specified as number."]);
    }
    my $msglen=int($bbb);
    my $id1=decode_base64(substr($buf,0,$next));
    # If type eq 'RSA' we need to check id1 is a key in pubkeys or need to abort...
    # Read the data block $msglen+1 bytes required...
    $wanted=$msglen+1;
    $buf='';
    while ($wanted) {
        my $bb='';
        if($wanted>1024) {
            recv($fd,$bb,1024,0);
        } else {
            recv($fd,$bb,$wanted,0);
        }
        if($bb) {
            $buf.=$bb;
            $wanted-=length($bb);
        } else {
            my $got=length($buf); my $ll=$msglen+1;
            return(0,["Failed to read data block ($got/$ll)."]);
        }
    }
    chomp $buf;
    my $msg=decode_base64($buf);
    if($type eq 'TXT') {
        return(1,$id1,$msg);
    }
    my $msg2=undef;
    if($private->{type} eq 'crypt::rsa') {
        my $rsa = new Crypt::RSA;
        $msg2=$rsa->decrypt(
            Cyphertext  => $msg,
            Key         => $private->{rsa_private_key},
            Armour      => 1
        ) || return(0,[$rsa->errstr()]);
    }
    eval {$msg2=$private->{rsa_private_key}->decrypt($msg); };
    if(!defined($msg2)) {
        return(0,["Failed to decrypt message with private key [message from '$id1']."]);
    }
    return(1,$id1,$msg2);
}

1;

